#!/usr/bin/perl -w
#
#	$Id: pmbmake 526 2007-10-12 02:41:44Z phrakt $
#
# pmbmake - poor man's BSD make
#
#
#
#

use strict;
use lib qw(../src/libdata/perl);


use constant TOK_ERROR			=> -1;
use constant TOK_EOF			=>  0;
use constant TOK_EOL			=>  1;
use constant TOK_STRING			=>  2;
use constant TOK_DIRECTIVE		=>  3;

use constant TOK_ASSIGN			=>  4;
use constant TOK_APPEND			=>  5;
use constant TOK_CNDASSIGN		=>  6;
use constant TOK_SHASSIGN		=>  7;
use constant TOK_COLON			=>  8;
use constant TOK_DBLCOLON		=>  9;
use constant TOK_WHITESPACE		=> 10;

# logical operators
use constant TOK_AND			=> 16;
use constant TOK_OR			=> 17;
use constant TOK_NOT			=> 18;

# arithmetic operators
use constant TOK_EQ			=> 32;
use constant TOK_NEQ			=> 33;
use constant TOK_GT			=> 34;
use constant TOK_GTEQ			=> 35;
use constant TOK_LT			=> 36;
use constant TOK_LTEQ			=> 37;

use constant TOK_LPAREN			=> 48;
use constant TOK_RPAREN			=> 49;


use Cwd;
use IO::Handle;
use Canopy::Util::Getopt;

use Data::Dumper;

$Data::Dumper::Sortkeys = 1;



# determine the program's name
$0 =~ /([^\/]*)$/;
my $progname = $1;

my $makefile = 'Makefile';
my $makeflags = '';


# List of directories to search in when looking for an included Makefile
my @mkdirs = qw(/usr/share/mk /usr/local/share/mk);


my %variables;
my %targets;


# Flags


my $noexec = 0;






# Parser stuff

my %operators = (
	'='		=> TOK_ASSIGN,
	'+='		=> TOK_APPEND,
	'?='		=> TOK_CNDASSIGN,
	'!='		=> TOK_SHASSIGN,
	'=='		=> TOK_EQ,
	'>'		=> TOK_GT,
	'>='		=> TOK_GTEQ,
	'<'		=> TOK_LT,
	'<='		=> TOK_LTEQ,
	'&&'		=> TOK_AND,
	'||'		=> TOK_OR,
	'!'		=> TOK_NOT,
	'('		=> TOK_LPAREN,
	')'		=> TOK_RPAREN,
	'::'		=> TOK_DBLCOLON,
	':'		=> TOK_COLON,
);

my %conditionals = (
	'if'		=> \&eval_if,
	'ifdef'		=> \&eval_ifdef,
	'ifndef'	=> \&eval_ifndef,
	'ifmake'	=> undef,
	'ifnmake'	=> undef,
	'else'		=> \&eval_else,
	'elif'		=> \&eval_elif,
	'elifdef'	=> undef,
	'elifndef'	=> undef,
	'elifmake'	=> undef,
	'elifnmake'	=> undef,
	'endif'		=> \&eval_endif,
	'undef'		=> \&eval_undef,
);

# This variable always holds the last token string found by lex()
my $token;

# Boolean specifying whether we should skip whitespace
my $lex_skipws = 1;

# Boolean specifying whether getchar() should perform variable substitution
my $lex_varsubst = 1;

my @pushback = ();

my @expr_stack = ();




exit(main());



########################################################################
# main - function
########################################################################

sub main
{
	$makeflags = join(' ', @ARGV);
	parse_argv();

	set_var(".MAKE", $progname);
	set_var(".CURDIR", getcwd());
	set_var(".OBJDIR");
	set_var(".MAKEFLAGS", $makeflags);
	set_var(".TARGETS");
	set_var(".INCLUDES");
	set_var(".LIBS");

	my $machine;
	if (exists($ENV{MACHINE})) {
		$machine = $ENV{MACHINE};
	} else {
		$machine = `uname -m`;
		chomp($machine);
	}

	set_var("MACHINE", $machine);
	set_var("MACHINE_ARCH", $machine);
	set_var("MFLAGS", $makeflags);
	set_var("PWD", getcwd());

	if (!parse_makefile({ file => $makefile})) {
		warn("Fatal errors encountered -- cannot continue\n");
	}

	print "VARIABLES:\n" . Dumper(\%variables);
	print "TARGETS:\n" . Dumper(\%targets);

	return (0);
}

########################################################################
# parse_argv - function
########################################################################

sub parse_argv
{
	my $opt;

	while (defined(my $opt = getopt('D:d:ef:hI:iknqrSstV:', @ARGV))) {
		if ($opt eq 'D') {
			set_var($OPTARG, 1);
		}
		elsif ($opt eq 'd') {
		}
		elsif ($opt eq 'e') {
		}
		elsif ($opt eq 'f') {
			$makefile = $OPTARG;
		}
		elsif ($opt eq 'h') {
			usage();
			exit(0);
		}
		elsif ($opt eq 'I') {
			push(@mkdirs, $OPTARG);
		}
		elsif ($opt eq 'i') {
		}
		elsif ($opt eq 'k') {
		}
		elsif ($opt eq 'n') {
			$noexec = 1;
		}
	}

}

########################################################################
# usage - function
########################################################################

sub usage
{
	my $progname = $0;
	$progname =~ s/([^\/]*)$/$1/;

	print STDERR <<EOU;
Usage: $progname [-h] [-D variable] [-f makefile] [target ...]
	-f makefile	Use <makefile> as the Makefile
	-h		Display usage information and exit
EOU
}

########################################################################
# get_var - function
########################################################################

sub get_var
{
	return $variables{$_[0]} if (exists($variables{$_[0]}));
	return '';
}

########################################################################
# set_var - function
########################################################################

sub set_var
{
	return if (line_ignored());

	my ($var, $val, $expr) = @_;

	$variables{$var} = $val;
}

########################################################################
# append_var - function
########################################################################

sub append_var
{
	return if (line_ignored());

	my ($var, $val) = @_;

	$variables{$var} = '' if (!exists($variables{$var}));
	$variables{$var} .= $val;
}

########################################################################
# parse_makefile - function
########################################################################

sub parse_makefile
{
	my $info = shift();
	my $fh = undef;
	my $t;
	my $expr_tree;

	print "Opening file $info->{file}\n";

	if (!open($fh, $info->{file})) {
		warn("$progname: Failed to open $info->{file}: $!\n");
		return;
	}

	$info->{fh} = $fh;
	$info->{line} = 1;

	while (($t = lex($info)) != TOK_EOF) {
		next if ($t == TOK_EOL);

		if ($t == TOK_ERROR) {
			return;
		}

		if ($t == TOK_DIRECTIVE) {

			if ($token eq 'include') {
				if (($t = lex($info)) != TOK_STRING) {
					return;
				}

				next if (line_ignored());

				my $file = undef;
				if ($token =~ /^\//) {
					$file = $token;
				}
				else {
					foreach (@mkdirs) {
						if (-e "$_/$token") {
							$file = "$_/$token";
							last;
						}
					}

					if (!defined($file)) {
						$file = getcwd() . '/' . $token;
					}
				}

				if (!parse_makefile({ file => $file })) {
					return;
				}

			}
			elsif (exists($conditionals{$token})) {
				my $res = $conditionals{$token}->($info);

				return if (!defined($res));
			}
			else {
			}

		}
		elsif ($t == TOK_STRING) {
			my $string = $token;
			$t = lex($info);

			if (($t == TOK_ASSIGN) || ($t == TOK_APPEND) ||
			    ($t == TOK_CNDASSIGN) || ($t == TOK_SHASSIGN)) {
				my $type = $t;
				my $value = '';
				my $overwrite = ($t == TOK_CNDASSIGN) ? 0 : 1;

				$lex_skipws = 0;

				if (($t = lex($info)) == TOK_WHITESPACE) {
					# skip whitespace at beginning
					$t = lex($info);
				}

				if ($t != TOK_EOL) {
					do {
						$value .= $token;
					} while (($t = lex($info)) != TOK_EOL);
				}

				$lex_skipws = 1;


				set_var($string, $value, $overwrite);
			}
			elsif (($t == TOK_COLON) || ($t == TOK_DBLCOLON) ||
			    ($t == TOK_NOT)) {
				print "TARGET $string\n";

				my @deps;

				while (($t = lex($info)) != TOK_EOL) {
					push(@deps, $token);
				}

				$targets{$string} = {
					deps	=> \@deps,
				};
			}
		}
	}

	$fh->close();

	return (1);
}

########################################################################
# eval_expr - function
########################################################################

sub eval_expr
{
	my $info = shift();
	my $t;
	my $r;
	my $result = 0;
	my @cond;

	if (($t = lex($info)) == TOK_LPAREN) {
		eval_expr($info);
	}
	elsif ($t == TOK_STRING) {
		$r = eval_condition($info);
		if (!defined($r)) {
			parse_error($info, "Malformed conditional");
			return;
		}

		push(@cond, $r);
	}
	else {
		return;
	}

	while (($t = lex($info)) != TOK_EOL) {

		if ($t == TOK_OR) {
			push(@cond, '||');
		}
		elsif ($t == TOK_AND) {
			push(@cond, '&&');
		}
		else {
			parse_error($info, "Syntax error: unexpected token `$token'");
			return;
		}

		if (($t = lex($info)) != TOK_STRING) {
			return;
		}

		$r = eval_condition($info);
		return if (!defined($r));
		push(@cond, $r);
	}

	my $expr = join(' ', @cond);
	print "Evaluating `$expr' to " . eval($expr) . "\n";

	return eval($expr);
}

########################################################################
# eval_condition - function
########################################################################

sub eval_condition
{
	my $info = shift();
	my $t;
	my $result = 0;

	if (($token eq 'defined') || ($token eq 'empty') ||
	    ($token eq 'exists') || ($token eq 'make') ||
	    ($token eq 'target')) {
		my $function = $token;
		my $arg = undef;

		if (($t = lex($info)) != TOK_LPAREN) {
			parse_error($info, "Syntax error: expected `(', got `$token'");
			return;
		}

		if (($t = lex($info)) == TOK_STRING) {
			$arg = $token;

			$t = lex($info);
		}

		if ($t != TOK_RPAREN) {
			parse_error($info, "Unclosed conditional");
			return;
		}


		if ($function eq 'defined') {
			print "Checking if the variable `$arg' is defined\n";
			if (defined($arg) && exists($variables{$arg})) {
				$result = 1;
			}
		}
		elsif ($function eq 'empty') {
			$result = 1 if (!defined($arg));
		}
		elsif ($function eq 'exists') {
			if (defined($arg)) {
				print "Testing for existence of file `$arg'\n";
				$result = 1 if (-e $arg);
			}
		}
		elsif ($function eq 'make') {
		}
		elsif ($function eq 'target') {
			if (exists($targets{$arg})) {
				$result = 1;
			}
		}
	}
	else {
		my $lhs = $token;

		$t = lex($info);
		if (($t == TOK_EOL) || ($t == TOK_AND) || ($t == TOK_OR)) {
			print "OOPS, READ TOO FAR\n";
			if ($lhs !~ /^\d+$/) {
				return;
			}

			$result = 1 if (int($lhs));

			ungetchar($token);
		}
		elsif (($t != TOK_EQ) && ($t != TOK_NEQ) && ($t != TOK_GT) &&
		    ($t != TOK_GTEQ) && ($t != TOK_LT) && ($t != TOK_LTEQ)) {
			parse_error($info, "Syntax error: relational operator expected");
			return;
		}
		my $op = $token;

		if (($t = lex($info)) != TOK_STRING) {
			parse_error($info, "Syntax error");
			return;
		}

	}

	return ($result);
}


########################################################################
# eval_if - function
########################################################################

sub eval_if
{
	my $info = shift();

	my $result = eval_expr($info);
	return if (!defined($result));

	push(@expr_stack, {
		met	=> $result,
		ignore	=> !$result,
	});

	return (1);
}

########################################################################
# eval_else - function
########################################################################

sub eval_else
{
	my $info = shift();

	if (@expr_stack == 0) {
		parse_error($info, "else conditional with no matching if");
		return;
	}

	next if ($expr_stack[-1]->{met} == 1);
	$expr_stack[-1]->{met} = 1;
	$expr_stack[-1]->{ignore} = 0;

	return (1);
}

########################################################################
# eval_elif - function
########################################################################

sub eval_elif
{
	my $info = shift();

	if (@expr_stack == 0) {
		parse_error($info, "elif conditional with no matching if");
		return;
	}

	my $res = eval_expr($info);

	next if ($expr_stack[-1]->{met} == 1);

	if ($res == 1) {
		$expr_stack[-1]->{met} = 1;
		$expr_stack[-1]->{ignore} = 0;
	} else {
		$expr_stack[-1]->{ignore} = 1;
	}

	return (1);
}

########################################################################
# eval_ifdef - function
########################################################################

sub eval_ifdef
{
	my $info = shift();
	my $t;

	if (($t = lex($info)) != TOK_STRING) {
		parse_error($info, "Invalid token passed to ifdef directive");
		return;
	}

	my $result = (exists($variables{$token}) ? 1 : 0);

	push(@expr_stack, {
		met	=> $result,
		ignore	=> !$result,
	});

	return (1);
}

########################################################################
# eval_ifndef - function
########################################################################

sub eval_ifndef
{
	return !eval_ifdef(@_);
}

########################################################################
# eval_endif - function
########################################################################

sub eval_endif
{
	my $info = shift();

	if (!defined(pop(@expr_stack))) {
		parse_error($info, "condition stack is empty");
		return;
	}

	return (1);
}

########################################################################
# eval_undef - function
########################################################################

sub eval_undef
{
	my $info = shift();
	my $t;

	if (($t = lex($info)) != TOK_STRING) {
		parse_error($info, "Invalid token passed to undef directive");
		return;
	}

	set_var($token, undef);
	return (1);
}


########################################################################
# line_ignored - function
########################################################################

sub line_ignored
{
	foreach (@expr_stack) {
		return (1) if ($_->{ignore} == 1);
	}

	return (0);
}

########################################################################
########################################################################
# lex - function
########################################################################


sub lex
{
	my $type = _lex($_[0]);

	$token = '\n' if ($token eq "\n");
#	print "TOKEN($type)=`$token'\n";

	return ($type);
}



sub _lex
{
	my $info = shift();
	my $type = TOK_ERROR;
	my $char = undef;
	my $fh = $info->{fh};

	$token = '';

	do {
		$token .= $char if (!$lex_skipws && defined($char));
		$char = getchar($fh);
	} while (defined($char) && (($char eq ' ') || ($char eq "\t")));

	if (!$lex_skipws && length($token) > 0) {
		ungetchar($char);
		return TOK_WHITESPACE;
	}

	return TOK_EOF if (!defined($char));

	if ($char eq "\n") {
		$info->{line}++;
		$token = $char;
		return TOK_EOL
	}

	if ($char eq '\\') {
		$char = getchar($fh);
		if ($char eq "\n") {
			$info->{line}++;
			return lex($info);
		}
		return ($char);
	}

	if (($char eq '=') || ($char eq '>') || ($char eq '<') ||
	    ($char eq '?') || ($char eq '!') || ($char eq '+') ||
	    ($char eq '(') || ($char eq ')') || ($char eq ':') ||
	    ($char eq '&') || ($char eq '|') || ($char eq '!') ||
	    ($char eq '=')) {

		# Attempt to be greedy and match a 2-character operator first.
		# If it fails, we pushback the character and try to match a
		# 1-character operator.
		my $op = $char;

		$char = getchar($fh);
		if (exists($operators{$op . $char})) {
			$token = $op . $char;
			$type = $operators{$token};
		}
		elsif (exists($operators{$op})) {
			$token = $op;
			$type = $operators{$op};
			ungetchar($char);
		}

	} elsif ($char eq '.') {

		do {
			$char = getchar($fh);
		} while (defined($char) && isspace($char));

		if (!defined($char)) {
			return;
		}

		do {
			$token .= $char;
		} while (isalnum($char = getchar($fh)));

		ungetchar($char);

		if (exists($conditionals{$token}) || $token eq 'include') {
			$type = TOK_DIRECTIVE;
		}
		else {
			$token = '.' . $token;
			$type = TOK_STRING;
		}
	}
	elsif ($char eq '"') {
		while (defined($char = getchar($fh)) && ($char ne '"')) {
			$token .= $char;
		}

		$type = TOK_STRING if (defined($char) && ($char eq '"'));
	}
	else {
		$token = $char;
		while (defined($char = getchar($fh)) &&
		    (index("(){} \t\n\"?=+!", $char) == -1)) {
			$token .= $char;
		}

		ungetchar($char) if ($char);

		$type = TOK_STRING;
	}

	return ($type);
}

########################################################################
# getchar - function
#
# Get the next available character from the input filehandle passed as
# argument.  This function actually does a little bit more than that:
# it takes care of removing any comments from the stream and performs
# variable substitution.
########################################################################

my $lastchar = undef;

sub getchar
{
	return shift(@pushback) if (@pushback > 0);

	my $fh = shift();

	my $char = $fh->getc();
	return if (!defined($char));

	if ($char eq '#') {
		# strip comment
		do {
			$char = $fh->getc();
		} while (defined($char) && ($char ne "\n"));

		return if (!defined($char));
	}

	if (($char eq '$') && $lex_varsubst) {
		# Perform variable substitution
		my $c = undef;
		my $var = '';

		$char = $fh->getc();
		if (($char eq '(') || ($char eq '{')) {
			$c = $char;

			while (defined($char = $fh->getc())) {
				if ((($c eq '(') && ($char eq ')')) ||
				    (($c eq '{') && ($char eq '}'))) {
					last;
				}

				$var .= $char;
			}
		}
		else {
			$var = $char;
		}

		my $value = get_var($var);
		if ($value eq '') {
			# If the variable has an empty value and is found
			# between whitespace, we replace it with a pair of
			# double quotes, in order to generate a TOK_STRING
			# token (with an empty string).
			$char = $fh->getc();
			if (isspace($lastchar) && isspace($char)) {
				$value = '""';
			}

			$fh->ungetc(ord($char));
		}

		if (length($value) > 0) {
#			print "Replacing `$var' with `$value'\n";
			ungetchar(reverse(split('', $value)));
			$char = shift(@pushback);
		}
		else {
			$char = $fh->getc();
		}

	}

	$lastchar = $char;
	return ($char);
}

########################################################################
# ungetchar - function
########################################################################

sub ungetchar
{
	unshift(@pushback, shift(@_)) while (@_ > 0);
}

########################################################################
# isalpha - function
########################################################################

sub isalpha
{
	if ((($_[0] ge 'A') && ($_[0] le 'Z')) ||
	    (($_[0] ge 'a') && ($_[0] le 'z'))) {
		return (1);
	}
	return (0);
}

########################################################################
# isspace - function
########################################################################

sub isspace
{
	return (1) if (($_[0] eq ' ') || ($_[0] eq "\t"));

	return (0);
}

########################################################################
# isalnum - function
########################################################################

sub isalnum
{
	return (0) if (!defined($_[0]));

	if ((($_[0] ge 'A') && ($_[0] le 'Z')) ||
	    (($_[0] ge 'a') && ($_[0] le 'z')) ||
	    (($_[0] ge '0') && ($_[0] le '9'))) {
		return (1);
	}

	return (0);
}


########################################################################
# parse_error - function
########################################################################

sub parse_error
{
	my $info = shift();
	my $msg = shift();

	print STDERR "$progname: \"$info->{file}\" line $info->{line}: $msg\n";
}
